home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / editors / emcs1857 / 1857sr~1.zoo / src / casetab.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-02  |  5.9 KB  |  224 lines
  1. /* GNU Emacs routines to deal with case tables.
  2.    Copyright (C) 1987 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY.  No author or distributor
  8. accepts responsibility to anyone for the consequences of using it
  9. or for whether it serves any particular purpose or works at all,
  10. unless he says so in writing.  Refer to the GNU Emacs General Public
  11. License for full details.
  12.  
  13. Everyone is granted permission to copy, modify and redistribute
  14. GNU Emacs, but only under the conditions described in the
  15. GNU Emacs General Public License.   A copy of this license is
  16. supposed to have been given to you along with GNU Emacs so you
  17. can know your rights and responsibilities.  It should be in a
  18. file named COPYING.  Among other things, the copyright notice
  19. and this notice must be preserved on all copies.  */
  20.  
  21. /* Written by Howard Gayle.  See chartab.c for details. */
  22.  
  23. #include "config.h"
  24. #include "lisp.h"
  25. #include "buffer.h"
  26. #include "casetab.h"
  27. #include "etctab.h"
  28.  
  29. Lisp_Object Qcase_table_p;
  30. DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0,
  31.    "Return t iff ARG is a case table.")
  32. (obj)
  33. Lisp_Object obj;
  34. {
  35. return ((XTYPE (obj) == Lisp_Casetab) ? Qt : Qnil);
  36. }
  37.  
  38. static Lisp_Object
  39. check_case_table (obj)
  40. Lisp_Object obj;
  41. {
  42. register Lisp_Object tem;
  43.  
  44. while (tem = Fcase_table_p (obj), NULL (tem))
  45.    obj = wrong_type_argument (Qcase_table_p, obj, 0);
  46. return (obj);
  47. }   
  48.  
  49. /* Convert the given Lisp_Casetab to a Lisp_Object. */
  50. static Lisp_Object
  51. enlisp_case_table (sp)
  52. struct Lisp_Casetab *sp;
  53. {
  54. register Lisp_Object z; /* Return. */
  55.  
  56. XSET (z, Lisp_Casetab, sp);
  57. return (z);
  58. }
  59.  
  60. DEFUN ("case-table", Fcase_table, Scase_table, 0, 0, 0,
  61.    "Return the case table of the current buffer.")
  62. ()
  63. {
  64. return (enlisp_case_table (current_buffer->case_table_v));
  65. }
  66.  
  67. DEFUN ("standard-case-table", Fstandard_case_table,
  68.    Sstandard_case_table, 0, 0, 0,
  69.    "Return the standard case table.\n\
  70. This is the one used for new buffers.")
  71. ()
  72. {
  73. return (enlisp_case_table (buffer_defaults.case_table_v));
  74. }
  75.  
  76. /* Extract the case table from the given Lisp object.  Check for errors. */
  77. static struct Lisp_Casetab *
  78. get_case_table_arg (obj)
  79. register Lisp_Object obj;
  80. {
  81. if (NULL (obj)) return (current_buffer->case_table_v);
  82. obj = check_case_table (obj);
  83. return (XCASETAB (obj));
  84. }
  85.  
  86. /* Store a case table.  Check for errors. */
  87. static Lisp_Object
  88. set_case_table (p, t)
  89. struct Lisp_Casetab **p; /* Points to where to store the case table. */
  90. register Lisp_Object  t; /* The case table as a Lisp object. */
  91. {
  92. t = check_case_table (t);
  93. *p = XCASETAB (t);
  94. return (t);
  95. }
  96.  
  97. DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0,
  98.    "Select a new case table for the current buffer.\n\
  99. One argument, a case table.")
  100. (table)
  101. Lisp_Object table;
  102. {
  103. return (set_case_table (¤t_buffer->case_table_v, table));
  104. }
  105.  
  106. DEFUN ("set-standard-case-table",
  107.    Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0,
  108.    "Select a new standard case table.  This does not change the\n\
  109. case tables of any existing buffers.  One argument, a case table.")
  110. (table)
  111. Lisp_Object table;
  112. {
  113. return (set_case_table (&buffer_defaults.case_table_v, table));
  114. }
  115.  
  116. DEFUN ("make-case-table", Fmake_case_table, Smake_case_table, 0, 0, 0,
  117.    "Make a new case table.  All characters are caseless.")
  118. ()
  119. {
  120. register struct Lisp_Casetab *nt; /* New case table. */
  121. register int                      i;
  122. register Lisp_Object           z;  /* Return. */
  123.  
  124. z = make_etc_table (sizeof (struct Lisp_Casetab), Lisp_Casetab);
  125. nt = XCASETAB (z);
  126. for (i = 0; i <= 255; ++i)
  127.    nt->cas_case[i] = nocase_e;
  128. return (z);
  129. }
  130.  
  131. DEFUN ("nocase-p", Fnocase_p, Snocase_p, 1, 2, 0,
  132.    "Return t iff character CHAR is caseless, according to case\n\
  133. table TABLE.")
  134. (ch, table)
  135. Lisp_Object ch;
  136. Lisp_Object table;
  137. {
  138. return (CASETAB_ISNOCASE (get_char_arg (ch), get_case_table_arg (table))
  139.         ? Qt : Qnil);
  140. }
  141.  
  142. DEFUN ("lower-p", Flower_p, Slower_p, 1, 2, 0,
  143.    "Return t iff character CHAR is lower case, according to case\n\
  144. table TABLE (default (case-table)).")
  145. (ch, table)
  146. Lisp_Object ch;
  147. Lisp_Object table;
  148. {
  149. return (CASETAB_ISLOWER (get_char_arg (ch), get_case_table_arg (table))
  150.         ? Qt : Qnil);
  151. }
  152.  
  153. DEFUN ("upper-p", Fupper_p, Supper_p, 1, 2, 0,
  154.    "Return t iff character CHAR is upper case, according to case\n\
  155. table TABLE (default (case-table)).")
  156. (ch, table)
  157. Lisp_Object ch;
  158. Lisp_Object table;
  159. {
  160. return (CASETAB_ISUPPER (get_char_arg (ch), get_case_table_arg (table))
  161.         ? Qt : Qnil);
  162. }
  163.  
  164. DEFUN ("set-case-table-nocase",
  165.    Fset_case_table_nocase, Sset_case_table_nocase, 1, 2, 0,
  166.    "Mark character CHAR as caseless in case table TABLE\n\
  167. (default (case-table)).")
  168. (ch, table)
  169. Lisp_Object ch;
  170. Lisp_Object table;
  171. {
  172. get_case_table_arg (table)->cas_case[get_char_arg (ch)] = nocase_e;
  173. return (ch);
  174. }
  175.  
  176. DEFUN ("set-case-table-pair",
  177.    Fset_case_table_pair, Sset_case_table_pair, 2, 3, 0,
  178.    "Mark characters LC and UC as an (upper case, lower case)\n\
  179. pair in case table TABLE (default (case-table)).")
  180. (lc, uc, table)
  181. Lisp_Object lc;
  182. Lisp_Object uc;
  183. Lisp_Object table;
  184. {
  185. register struct Lisp_Casetab *cp = get_case_table_arg (table);
  186. register char_t lch = get_char_arg (lc);
  187. register char_t uch = get_char_arg (uc);
  188.  
  189. cp->cas_case[lch] = lowercase_e;
  190. cp->cas_case[uch] = uppercase_e;
  191. return (lc);
  192. }
  193.  
  194. init_case_table_once ()
  195. {
  196. register int i;
  197. register case_t *p;
  198.  
  199. Fset_standard_case_table (Fmake_case_table ());
  200. p = buffer_defaults.case_table_v->cas_case;
  201. for (i = 'A'; i <= 'Z'; ++i)
  202.    p[i] = uppercase_e;
  203. for (i = 'a'; i <= 'z'; ++i)
  204.    p[i] = lowercase_e;
  205. }
  206.  
  207. syms_of_case_table ()
  208. {
  209. Qcase_table_p = intern ("case-table-p");
  210. staticpro (&Qcase_table_p);
  211.  
  212. defsubr (&Scase_table_p);
  213. defsubr (&Scase_table);
  214. defsubr (&Sstandard_case_table);
  215. defsubr (&Sset_case_table);
  216. defsubr (&Sset_standard_case_table);
  217. defsubr (&Smake_case_table);
  218. defsubr (&Snocase_p);
  219. defsubr (&Slower_p);
  220. defsubr (&Supper_p);
  221. defsubr (&Sset_case_table_nocase);
  222. defsubr (&Sset_case_table_pair);
  223. }
  224.